home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon4Amiga / Dialogs / DialogFrames.Mod (.txt) < prev    next >
Oberon Text  |  1994-11-28  |  8KB  |  215 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 7 Nov 94
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogFrames;    (* J. Templ, 07.04.93 *)
  8.     (** extended version Markus Knasm
  9. ller 25.May.94 -  
  10.     IMPORT
  11.         Dialogs, Display, Files, Input, MenuViewers, Oberon, TextFrames, Texts, Viewers;
  12.     CONST
  13.         bkCol = 13;
  14.         menu = "System.Close  System.Copy  System.Grow";
  15.         gridMax* = 100; gridMin* = 1;
  16.     TYPE
  17.         Frame* = POINTER TO FrameDesc;
  18.         FrameDesc* = RECORD(Display.FrameDesc)
  19.             col*: INTEGER;  (** background-color of the frame *)
  20.             panel*: Dialogs.Panel;  (** panel displayed in this frame *)
  21.             grid*: INTEGER; (** grid of the frame *)
  22.         END;
  23.         GetFrameMsg* = RECORD(Display.FrameMsg)
  24.             p*: Dialogs.Panel;
  25.             f*: Frame;
  26.         END;
  27.         SetCaretMsg = RECORD(Display.FrameMsg)
  28.             p: Dialogs.Panel;  
  29.             x, y: INTEGER;
  30.         END; 
  31.         w0: Texts.Writer;
  32.         left, right, top, bot: INTEGER;
  33.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  34.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  35.     END Min;
  36.     PROCEDURE (f: Frame) MarkMenu; 
  37.     (* see TextFrames *)
  38.         VAR r: Texts.Reader; v: Viewers.Viewer; t: Texts.Text; ch: CHAR; 
  39.     BEGIN 
  40.         v := Viewers.This (f.X, f.Y);
  41.         IF (v IS MenuViewers.Viewer) & (v.dsc IS TextFrames.Frame) & (f # v.dsc) THEN
  42.             t := v.dsc(TextFrames.Frame).text;
  43.             IF t.len > 0 THEN Texts.OpenReader(r, t, t.len - 1); Texts.Read(r, ch) ELSE ch := 0X END;
  44.             IF ch # "!" THEN Texts.Write(w0, "!"); Texts.Append(t, w0.buf) END
  45.         END;
  46.     END MarkMenu;
  47.     PROCEDURE (f: Frame) Restore*;
  48.     (** restores the frame *)
  49.     BEGIN
  50.         Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); Display.ReplConstC (f, f.col, f.X, f.Y, f.W, f.H, Display.replace);
  51.         f.panel.Draw (f.X, f.Y + f.H, f)
  52.     END Restore;
  53.     PROCEDURE (f: Frame) DrawObject (o: Dialogs.Object; drawmode: BOOLEAN);
  54.     (* mode = TRUE => Draw  -  mode = FALSE => Delete *)
  55.         VAR x, y, ox, oy, ow, oh: INTEGER; i: LONGINT;
  56.     BEGIN 
  57.         o.GetDim (ox, oy, ow, oh); x := f.X + ox; y := f.Y + f.H + oy; 
  58.         Oberon.RemoveMarks (x, y, ow, oh); 
  59.         IF (~ drawmode) THEN  
  60.             Display.ReplConstC (f, f.col, x, y, ow, oh, Display.paint)
  61.         ELSE
  62.             o.Draw (x, y, f) 
  63.         END
  64.     END DrawObject;
  65.     PROCEDURE (f: Frame) TrackMouse (x, y: INTEGER; keys: SET);
  66.     BEGIN 
  67.         Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
  68.         WHILE keys # {} DO
  69.             Input.Mouse (keys, x, y);
  70.             Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
  71.         END 
  72.     END TrackMouse;
  73.     PROCEDURE (f: Frame) Send (x, y: INTEGER; VAR m: Display.FrameMsg; VAR cond: BOOLEAN);
  74.         VAR o: Dialogs.Object;
  75.     BEGIN
  76.         o := f.panel.ThisObject (x - f.X, y - f.Y - f.H);
  77.         IF o # NIL THEN o.Handle (f, m); cond := TRUE ELSE cond := FALSE END 
  78.     END Send;
  79.     PROCEDURE (f: Frame) Extend (newY: INTEGER);
  80.         VAR dY, newH: INTEGER;
  81.     BEGIN 
  82.         dY := f.Y - newY;
  83.         Display.ReplConst(f.col, f.X, newY, f.W, f.Y - newY, Display.replace);
  84.         f.H := f.H + f.Y - newY; f.Y := newY;
  85.         f.panel.Draw (f.X, f.Y + f.H, f);
  86.     END Extend;
  87.     PROCEDURE (f: Frame) Reduce (newY: INTEGER);
  88.     BEGIN
  89.         f.H := f.H + f.Y - newY; f.Y := newY;
  90.     END Reduce;
  91.     PROCEDURE(f: Frame) Modify (id, dY, y, h: INTEGER);
  92.     BEGIN
  93.         Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  94.         IF id = MenuViewers.extend THEN
  95.             IF dY > 0 THEN
  96.                 Display.ReplConst(f.col, f.X, f.Y + dY, f.W, f.H, Display.replace); INC (f.Y, dY);
  97.             END;
  98.             f.Extend (y);
  99.         ELSIF id = MenuViewers.reduce THEN
  100.             f.Reduce (y + dY);
  101.             IF dY > 0 THEN Display.CopyBlock(f.X, f.Y, f.W, f.H, f.X, y, Display.replace); f.Y := y END
  102.         END
  103.     END Modify;
  104.     PROCEDURE Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
  105.     (** handles the message m sent to frame f *)
  106.     VAR cond: BOOLEAN; copy: Frame;
  107.         PROCEDURE IsIn (f: Display.Frame; x, y: INTEGER): BOOLEAN;
  108.         BEGIN
  109.             IF (x >= f.X) & (x <= f.X + f.W) & (y > f.Y) & (y <= f.Y + f.H) THEN RETURN TRUE ELSE RETURN FALSE END
  110.         END IsIn;
  111.     BEGIN
  112.         WITH f: Frame DO
  113.             WITH m: Oberon.InputMsg DO 
  114.                 IF m.id = Oberon.track THEN 
  115.                     IF IsIn (f, m.X, m.Y) THEN
  116.                         f.Send (m.X, m.Y, m, cond); (* sends it to object *)
  117.                         IF ~ cond THEN f.TrackMouse (m.X, m.Y, m.keys) (* draws cursor if there is no object *) END
  118.                     END
  119.                 ELSE f.panel.Broadcast (f, m)
  120.                 END
  121.             | m: MenuViewers.ModifyMsg DO f.Modify (m.id, m.dY, m.Y, m.H)
  122.             | m: Oberon.CopyMsg DO NEW (copy); copy^ := f^; m.F := copy; 
  123.             | m: Dialogs.NotifyMsg DO
  124.                 IF m.id = 0 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, TRUE) END
  125.                 ELSIF m.id = 1 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, FALSE) END
  126.                 ELSIF m.id = 2 THEN IF m.p = f.panel THEN  f.MarkMenu END
  127.                 ELSIF m.id = 3 THEN IF m.p = f.panel THEN f.Restore END
  128.                 END
  129.             | m: SetCaretMsg DO
  130.                 IF m.p = f.panel THEN
  131.                     Oberon.Pointer.X := m.x + f.X; Oberon.Pointer.Y := m.y + f.Y + f.H;
  132.                 END
  133.             | m: GetFrameMsg DO
  134.                 IF f.panel = m.p THEN m.f := f END
  135.             ELSE
  136.                 f.panel.Broadcast (f, m)  (* sends it to all objects in the panel *)
  137.             END
  138.         END
  139.     END Handle;
  140.     PROCEDURE (f: Frame) Open* (handle: Display.Handler; p: Dialogs.Panel);
  141.     (** opens the frame f with the handler handle and the panel p *)
  142.     BEGIN f.handle := handle; f.panel := p; f.col := bkCol; f.grid := 1;
  143.     END Open;
  144.     PROCEDURE GetCaretPosition* (VAR p: Dialogs.Panel; VAR xpos, ypos: INTEGER);
  145.     (** returns the panel p and the positin (xpos, ypos) of the caret *)
  146.         VAR x, y: INTEGER; f: Frame; v: Viewers.Viewer;
  147.     BEGIN
  148.         x := Oberon.Pointer.X; y := Oberon.Pointer.Y; v := Viewers.This (x, y);
  149.         IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS Frame) THEN 
  150.             f := v.dsc.next(Frame); p := f.panel; xpos := x - f.X; ypos := y - f.Y - f.H 
  151.         ELSE p := NIL
  152.         END
  153.      END GetCaretPosition;
  154.     PROCEDURE box (obj: Dialogs.Object; VAR done: BOOLEAN);
  155.         VAR x, y, w, h: INTEGER;
  156.     BEGIN
  157.         obj.GetDim (x, y, w, h);
  158.         IF x < left THEN left := x END;
  159.         IF y < bot THEN bot := y END;
  160.         IF x + w > right THEN right := x + w END;
  161.         IF y + h > top THEN top := y + h END
  162.     END box;
  163.     PROCEDURE OpenPanel* (name: ARRAY OF CHAR; x, y: INTEGER; VAR p: Dialogs.Panel);
  164.     (** reads a panel p from file name and opens a viewer at x, y showing that panel *)
  165.         VAR f: Frame; file: Files.File; r: Files.Rider; h, res: INTEGER; v, vmax: Viewers.Viewer; m: TextFrames.Frame;
  166.             t: Texts.Text; buf: Texts.Buffer; 
  167.     BEGIN
  168.         file := Files.Old (name); NEW (p); 
  169.         IF file # NIL THEN Files.Set (r, file, 0); p.Load (r) END;
  170.         NEW (f); f.Open (Handle, p); 
  171.         v := Viewers.This (x, 0);  vmax := NIL; h := 0;
  172.         WHILE v.state > 1  DO 
  173.             IF v.H > h THEN vmax := v; h := v.H END;
  174.             v := Viewers.Next (v)
  175.         END;
  176.         IF vmax # NIL THEN
  177.             left := MAX (INTEGER); right := MIN (INTEGER); bot := MAX (INTEGER); top := MIN (INTEGER);
  178.             p.Enumerate (box);
  179.             y := Min (vmax.Y + ABS (bot) + 10 + TextFrames.menuH, vmax.Y + vmax.H - TextFrames.menuH - 2) 
  180.         END; 
  181.         IF Files.Old ("Dialog.Menu.Text") = NIL THEN 
  182.             m := TextFrames.NewMenu (name, menu)
  183.         ELSE 
  184.             m := TextFrames.NewMenu (name, "");
  185.             NEW (t); Texts.Open (t, "Dialog.Menu.Text");
  186.             NEW (buf); Texts.OpenBuf (buf); Texts.Save (t, 0, t.len, buf); Texts.Append (m.text, buf)
  187.         END;
  188.         v := MenuViewers.New (m, f, TextFrames.menuH, x, y);
  189.         IF p.cmd[0] # 0X THEN 
  190.             Dialogs.cmdPanel := p; 
  191.             Oberon.Call (p.cmd, Oberon.Par, FALSE, res)
  192.         END;
  193.     END OpenPanel;
  194.     PROCEDURE FindObject* (VAR o: Dialogs.Object; VAR p: Dialogs.Panel);
  195.     (** returns the object o below the caret and the panel p containing it *)
  196.         VAR x, y: INTEGER;
  197.     BEGIN
  198.         GetCaretPosition (p, x, y);
  199.         IF p # NIL THEN 
  200.             o := p.ThisObject (x, y);
  201.             IF o # NIL THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.objectNotFound END
  202.         ELSE Dialogs.res := Dialogs.noPanelSelected
  203.         END
  204.     END FindObject;            
  205.     PROCEDURE SetCaretAtObject* (o: Dialogs.Object);
  206.     (** sets the caret in a way that the object o is below the caret *)
  207.         VAR msg: SetCaretMsg; x, y, w, h: INTEGER;
  208.     BEGIN
  209.         o.GetDim (x, y, w, h);
  210.         msg.p := o.panel; msg.x := x; msg.y := y;
  211.         Viewers.Broadcast (msg)
  212.     END SetCaretAtObject; 
  213. BEGIN Texts.OpenWriter (w0)
  214. END DialogFrames.
  215.